home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / src / tclXdup.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-19  |  8.6 KB  |  290 lines
  1. /*
  2.  * tclXdup.c
  3.  *
  4.  * Extended Tcl dup command.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXdup.c,v 3.0 1993/11/19 06:58:34 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Prototypes of internal functions.
  23.  */
  24. static int
  25. ConvertFileHandle _ANSI_ARGS_((Tcl_Interp *interp,
  26.                                char       *handle));
  27.  
  28. static FILE *
  29. DoNormalDup _ANSI_ARGS_((Tcl_Interp *interp,
  30.                          OpenFile   *oldFilePtr));
  31.  
  32. static FILE *
  33. DoSpecifiedDup _ANSI_ARGS_((Tcl_Interp *interp,
  34.                             OpenFile   *oldFilePtr,
  35.                             char       *newFileId));
  36.  
  37.  
  38. /*
  39.  *-----------------------------------------------------------------------------
  40.  *
  41.  * ConvertFileHandle --
  42.  *
  43.  * Convert a file handle to its file number. The file handle maybe one 
  44.  * of "stdin", "stdout" or "stderr" or "fileNNN", were NNN is the file
  45.  * number.  If the handle is invalid, -1 is returned and a error message
  46.  * will be returned in interp->result.  This is used when the file may
  47.  * not be currently open.
  48.  *
  49.  *-----------------------------------------------------------------------------
  50.  */
  51. static int
  52. ConvertFileHandle (interp, handle)
  53.     Tcl_Interp *interp;
  54.     char       *handle;
  55. {
  56.     int fileId = -1;
  57.  
  58.     if (handle [0] == 's') {
  59.         if (STREQU (handle, "stdin"))
  60.             fileId = 0;
  61.         else if (STREQU (handle, "stdout"))
  62.             fileId = 1;
  63.         else if (STREQU (handle, "stderr"))
  64.             fileId = 2;
  65.     } else {
  66.        if (STRNEQU (handle, "file", 4))
  67.            Tcl_StrToInt (&handle [4], 10, &fileId);
  68.     }
  69.     if (fileId < 0)
  70.         Tcl_AppendResult (interp, "invalid file handle: ", handle,
  71.                           (char *) NULL);
  72.     return fileId;
  73. }
  74.  
  75. /*
  76.  *-----------------------------------------------------------------------------
  77.  *
  78.  * DoNormalDup --
  79.  *   Process a normal dup command (i.e. the new file is not specified).
  80.  *
  81.  * Parameters:
  82.  *   o interp (I) - If an error occures, the error message is in result.
  83.  *   o oldFilePtr (I) - Tcl file control block for the file to dup.
  84.  * Returns:
  85.  *   A pointer to the file structure for the new file, or NULL if an
  86.  * error occured.
  87.  *-----------------------------------------------------------------------------
  88.  */
  89. static FILE *
  90. DoNormalDup (interp, oldFilePtr)
  91.     Tcl_Interp *interp;
  92.     OpenFile   *oldFilePtr;
  93. {
  94.     int    newFileId;
  95.     FILE  *filePtr;
  96.  
  97.     newFileId = dup (fileno (oldFilePtr->f));
  98.     if (newFileId < 0)
  99.         goto unixError;
  100.  
  101.     filePtr = Tcl_SetupFileEntry (interp, newFileId, oldFilePtr->permissions);
  102.  
  103.     return filePtr;
  104.  
  105. unixError:
  106.     interp->result = Tcl_PosixError (interp);
  107.     return NULL;
  108. }
  109.  
  110. /*
  111.  *-----------------------------------------------------------------------------
  112.  *
  113.  * DoSpecifiedDup --
  114.  *   Process a dup command where the file is dupped to a specified fileid.
  115.  * The new file may or be open or closed, but its better if is open 
  116.  * if stdin, stdout or stderr are being used, otherwise the a different
  117.  * stdio file descriptior maybe bound to these descriptors.
  118.  *
  119.  * Parameters:
  120.  *   o interp (I) - If an error occures, the error message is in result.
  121.  *   o oldFilePtr (I) - Tcl file control block for the file to dup.
  122.  *   o targetFileId (I) - The id (handle) name for the new file.
  123.  * Returns:
  124.  *   A pointer to the open structure for the new file, or NULL if an
  125.  * error occured.
  126.  *-----------------------------------------------------------------------------
  127.  */
  128. static FILE *
  129. DoSpecifiedDup (interp, oldFilePtr, targetFileId)
  130.     Tcl_Interp *interp;
  131.     OpenFile   *oldFilePtr;
  132.     char       *targetFileId;
  133. {
  134.     int    targetFileNum = -1;
  135.     FILE  *targetFilePtr;
  136.     char  *mode;
  137.  
  138.     /*
  139.      * Determine if the target file is currently open.  Also get the file
  140.      * number for the file.  Also flush the file.
  141.      */
  142.     if (Tcl_GetOpenFile (interp, targetFileId, 
  143.                          FALSE, FALSE,  /* No checking */
  144.                          &targetFilePtr) != TCL_OK) {
  145.         Tcl_ResetResult (interp);
  146.         targetFilePtr = NULL;
  147.  
  148.         targetFileNum = ConvertFileHandle (interp, targetFileId);
  149.         if (targetFileNum < 0)
  150.             return NULL;
  151.  
  152.     } else {
  153.         targetFileNum = fileno (targetFilePtr);
  154.         fflush (targetFilePtr);
  155.     }
  156.  
  157.     /*
  158.      * If this is not one of the standard files, close it.  This will do all
  159.      * Tcl cleanup in case its a pipeline, etc.
  160.      */
  161.     if ((targetFilePtr != NULL) && (targetFileNum > 2)) {
  162.         char *argv [2];
  163.  
  164.         argv [0] = "dup";
  165.         argv [1] = targetFileId;
  166.         if (Tcl_CloseCmd (NULL, interp, 2, argv) != TCL_OK)
  167.             return NULL;
  168.         targetFilePtr = NULL;
  169.     }
  170.  
  171.     /*
  172.      * Duplicate the old file to the specified file id.  This functionallity
  173.      * could be obtained with dup2 on most systems.
  174.      */
  175.     close (targetFileNum);
  176.     if (fcntl (fileno (oldFilePtr->f), F_DUPFD, targetFileNum) < 0)
  177.         goto unixError;
  178.  
  179.     /*
  180.      * If the file is not open, setup a FILE structure and tell Tcl about it.
  181.      */
  182.     if (targetFilePtr == NULL) {
  183.         targetFilePtr = Tcl_SetupFileEntry (interp, targetFileNum,
  184.                                             oldFilePtr->permissions);
  185.         if (targetFilePtr == NULL)
  186.             goto unixError;
  187.     }
  188.  
  189.     return targetFilePtr;
  190.  
  191. unixError:
  192.     interp->result = Tcl_PosixError (interp);
  193.     if (targetFileNum >= 0)
  194.         close (targetFileNum);
  195.     return NULL;
  196. }
  197.  
  198. /*
  199.  *-----------------------------------------------------------------------------
  200.  *
  201.  * Tcl_DupCmd --
  202.  *     Implements the dup TCL command:
  203.  *         dup fileId ?targetFileId?
  204.  *
  205.  * Results:
  206.  *      Returns TCL_OK and interp->result containing a filehandle
  207.  *      if the requested file or pipe was successfully duplicated.
  208.  *
  209.  *      Return TCL_ERROR and interp->result containing an
  210.  *      explanation of what went wrong if an error occured.
  211.  *
  212.  * Side effects:
  213.  *      Locates and creates an entry in the handles table
  214.  *
  215.  *-----------------------------------------------------------------------------
  216.  */
  217. int
  218. Tcl_DupCmd (clientData, interp, argc, argv)
  219.     ClientData  clientData;
  220.     Tcl_Interp *interp;
  221.     int         argc;
  222.     char      **argv;
  223. {
  224.     OpenFile *oldFilePtr;
  225.     FILE     *newFilePtr;
  226.     long      seekOffset = -1;
  227.  
  228.     if ((argc < 2) || (argc > 3)) {
  229.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0], 
  230.                           " fileId ?targetFileId?", (char *) NULL);
  231.         return TCL_ERROR;
  232.     }
  233.  
  234.     oldFilePtr = Tcl_GetOpenFileStruct (interp, argv[1]);
  235.     if (oldFilePtr == NULL)
  236.     return TCL_ERROR;
  237.  
  238.     if (oldFilePtr->numPids > 0) {
  239.         Tcl_AppendResult (interp, "can not `dup' a pipeline", (char *) NULL);
  240.         return TCL_ERROR;
  241.     }
  242.  
  243.     /*
  244.      * If writable, flush out the buffer.  If readable, remember were we are
  245.      * so the we can set it up for the next stdio read to come from the same
  246.      * place.  The location is only recorded if the file is a reqular file,
  247.      * since you cann't seek on other types of files.
  248.      */
  249.     if (oldFilePtr->permissions  & TCL_FILE_WRITABLE) {
  250.         if (fflush (oldFilePtr->f) != 0)
  251.             goto unixError;
  252.     }
  253.     if (oldFilePtr->permissions & TCL_FILE_READABLE) {
  254.         struct stat statBuf;
  255.         
  256.         if (fstat (fileno (oldFilePtr->f), &statBuf) < 0)
  257.             goto unixError;
  258.         if ((statBuf.st_mode & S_IFMT) == S_IFREG) {
  259.             seekOffset = ftell (oldFilePtr->f);
  260.             if (seekOffset < 0)
  261.                 goto unixError;
  262.         }
  263.     }
  264.  
  265.     /*
  266.      * Process the dup depending on if dup-ing to a new file or a target
  267.      * file handle.
  268.      */
  269.     if (argc == 2)
  270.         newFilePtr = DoNormalDup (interp, oldFilePtr);
  271.     else
  272.         newFilePtr = DoSpecifiedDup (interp, oldFilePtr, argv [2]);
  273.  
  274.     if (newFilePtr == NULL)
  275.         return TCL_ERROR;
  276.  
  277.     if (seekOffset >= 0) {
  278.         if (fseek (newFilePtr, seekOffset, SEEK_SET) != 0)
  279.             goto unixError;
  280.     }
  281.     Tcl_ResetResult (interp);
  282.     sprintf (interp->result, "file%d", fileno (newFilePtr));
  283.     return TCL_OK;
  284.  
  285. unixError:
  286.     Tcl_ResetResult (interp);
  287.     interp->result = Tcl_PosixError (interp);
  288.     return TCL_ERROR;
  289. }
  290.